home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / games / yow.el.z / yow.el
Encoding:
Text File  |  1998-05-21  |  3.9 KB  |  132 lines
  1. ;;; yow.el --- quote random zippyisms
  2.  
  3. ;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
  4.  
  5. ;; Maintainer: FSF
  6. ;; Author: Richard Mlynarik
  7. ;; Keywords: games
  8.  
  9. ;; This file is part of XEmacs.
  10.  
  11. ;; XEmacs is free software; you can redistribute it and/or modify it
  12. ;; under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation; either version 2, or (at your option)
  14. ;; any later version.
  15.  
  16. ;; XEmacs is distributed in the hope that it will be useful, but
  17. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19. ;; General Public License for more details.
  20.  
  21. ;; You should have received a copy of the GNU General Public License
  22. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  23. ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  24.  
  25. ;;; Synched up with: FSF 19.34.
  26.  
  27. ;;; Commentary:
  28.  
  29. ;; Important pinheadery for GNU Emacs.
  30. ;;
  31. ;; See cookie1.el for implementation.  Note --- the `n' argument of yow
  32. ;; from the 18.xx implementation is no longer; we only support *random*
  33. ;; random access now.
  34.  
  35. ;;; Code:
  36.  
  37. (require 'cookie1)
  38.  
  39. (defvar yow-file (locate-data-file "yow.lines")
  40.    "File containing pertinent Pinhead Phrases.")
  41.  
  42. (defconst yow-load-message "Am I CONSING yet?...")
  43. (defconst yow-after-load-message "I have SEEN the CONSING!!")
  44.  
  45. ;;;###autoload
  46. (defun yow (&optional insert)
  47.   "Return or display a random Zippy quotation.  With prefix arg, insert it."
  48.   (interactive "P")
  49.   (let ((yow (cookie yow-file yow-load-message yow-after-load-message)))
  50.     (cond (insert
  51.        (insert yow))
  52.       ((not (interactive-p))
  53.            yow)
  54.           ((not (string-match "\n" yow))
  55.        (delete-windows-on (get-buffer-create "*Help*"))
  56.        (message "%s" yow))
  57.       (t
  58.        (message "Yow!")
  59.        (with-output-to-temp-buffer "*Help*"
  60.          (princ yow)
  61.          (save-excursion
  62.            (set-buffer standard-output)
  63.            (help-mode)))))))
  64.  
  65. (defun read-zippyism (prompt &optional require-match)
  66.   "Read a Zippyism from the minibuffer with completion, prompting with PROMPT.
  67. If optional second arg is non-nil, require input to match a completion."
  68.   (read-cookie prompt yow-file yow-load-message yow-after-load-message
  69.            require-match))
  70.  
  71. ;;;###autoload
  72. (defun insert-zippyism (&optional zippyism)
  73.   "Prompt with completion for a known Zippy quotation, and insert it at point."
  74.   (interactive (list (read-zippyism "Pinhead wisdom: " t)))
  75.   (insert zippyism))
  76.  
  77. ;;;###autoload
  78. (defun apropos-zippy (regexp)
  79.   "Return a list of all Zippy quotes matching REGEXP.
  80. If called interactively, display a list of matches."
  81.   (interactive "sApropos Zippy (regexp): ")
  82.   ;; Make sure yows are loaded
  83.   (cookie yow-file yow-load-message yow-after-load-message)
  84.   (let* ((case-fold-search t)
  85.      (cookie-table-symbol (intern yow-file cookie-cache))
  86.      (string-table (symbol-value cookie-table-symbol))
  87.      (matches nil)
  88.      (len (length string-table))
  89.      (i 0))
  90.     (save-match-data
  91.       (while (< i len)
  92.     (and (string-match regexp (aref string-table i))
  93.          (setq matches (cons (aref string-table i) matches)))
  94.     (setq i (1+ i))))
  95.     (and matches
  96.      (setq matches (sort matches 'string-lessp)))
  97.     (and (interactive-p)
  98.      (cond ((null matches)
  99.         (message "No matches found."))
  100.            (t
  101.         (let ((l matches))
  102.           (with-output-to-temp-buffer "*Zippy Apropos*"
  103.             (while l
  104.               (princ (car l))
  105.               (setq l (cdr l))
  106.               (and l (princ "\n\n"))))))))
  107.     matches))
  108.  
  109.  
  110. ;; Yowza!! Feed zippy quotes to the doctor. Watch results.
  111. ;; fun, fun, fun. Entertainment for hours...
  112. ;;
  113. ;; written by Kayvan Aghaiepour
  114.  
  115. ;;;###autoload
  116. (defun psychoanalyze-pinhead ()
  117.   "Zippy goes to the analyst."
  118.   (interactive)
  119.   (doctor)                ; start the psychotherapy
  120.   (message "")
  121.   (switch-to-buffer "*doctor*")
  122.   (sit-for 0)
  123.   (while (not (input-pending-p))
  124.     (insert-string (yow))
  125.     (sit-for 0)
  126.     (doctor-ret-or-read 1)
  127.     (doctor-ret-or-read 1)))
  128.  
  129. (provide 'yow)
  130.  
  131. ;;; yow.el ends here
  132.